perm filename REVERB.FOR[ZZZ,LCS] blob
sn#414623 filedate 1979-05-08 generic text, type T, neo UTF8
SUBROUTINE REVERB
COMMON /LM/L(10),M(10),NSAMX /ROUT/ROUT(1) /MM/MM,NSM
1 /NT/RNT(1)
EQUIVALENCE (L1,L(1)),(L2,L(2)),(L3,L(3))
DIMENSION DL(4050),X(8),LD(8),JDS(8)
C NEXT ARE THE VARIOUS DELAY TIMES AND MULTIPIERS.
DATA LD/801, 901, 1011, 1123, 123, 43, 23, 13/
1, X/0.827, 0.805, 0.783, 0.764, 0.7, 0.7, 0.7, 0.7/
C BE SURE THAT SUM OF ALL LD VALUES IS LESS OR = TO TOTAL DL ARRAY.
C FOLLOWING IS A TYPICAL MUS10 REVERB INST.
C INSTRUMENT REV;
C REV1(R,801,.827,D1); REV1(R,901,.805,D2);
C REV1(R,1011,.783,D3); REV1(R,1123,.764,D4);
C REV2(U1+U2+U3+U4,123,.7,D5); REV2(U5,43,.7,D6);
C REV2(U6,23,.7,D7); REV2(U6,13,.7,D8);
C R←0;OUTA←OUTA+U8; END;
IF(RNT(L3).EQ.0)GO TO 4
C SET P3 TO 1 TO INITIALIZE REVERB.
RNT(L3)=0
DO 5 K=1,4050
5 DL(K)=0
CLEAR DELAY ARRAYS
DO 6 K=1,8
6 JDS(K)=0
C SET ALL POINTERS TO ZERO
4 DO 1 K=0,NSAMX
1 ROUT(K+L2)=0
CLEAR OUTPUT ARRAY.
N=1
J=L1
MM=0
NSM=NSAMX+1
DO 2 K=1,8
CALL REVX(DL(N),LD(K),X(K),JDS(K),ROUT(L2),ROUT(J))
IF(K.NE.4)GO TO 2
J=L2
MM=-1
C THESE CHANGES COME FOR 'REV2' PROCESS
2 N=N+LD(K)
C UPDATES POINTER IN DELAY ARRAY.
DO 3 K=0,NSAMX
3 ROUT(L1+K)=0
C CLEAR INPUT ARRAY.
END
SUBROUTINE REVX(DL,LD,X,JDS,DOUT,DIN)
COMMON /MM/MM,NSM
DIMENSION DL(1),DOUT(1),DIN(1)
JD=JDS
DO 1 K=1,NSM
JD=JD+1
DS=DL(JD)
IF(MM.NE.0)GO TO 2
DOUT(K)=DS+DOUT(K)
C GET OUTPUT FROM DELAY LOOP AND ADD IT INTO OUTPUT BLOCK.
DL(JD)=DS*X+DIN(K)
C ADD SIGNAL INTO DELAY LOOP
GO TO 1
2 DN=DIN(K)
DX=(DS-DN)*X
DOUT(K)=DS+DX
C THIS IS 'REV2' PROCESS
DL(JD)=DX+DN
C ADD SIGNAL INTO DELAY LOOP
1 IF(JD.GE.LD)JD=0
JDS=JD
END